(define-module (grump byte-reader)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 iconv)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (system foreign)
  #:export (byte-reader
            byte-reader?

            get-bytes
            get-ascii
            get-int32
            get-byte

            read-bytes
            read-ascii
            read-int32
            read-byte
            read-remaining-bytes

            assert-bytes
            assert-ascii
            assert-int32
            assert-byte))

(define-record-type <byte-reader>
  (%make-byte-reader port cursor length buffer)
  byte-reader?
  (port    byte-reader-port)
  (cursor  byte-reader-cursor set-byte-reader-cursor!)
  (length  byte-reader-length set-byte-reader-length!)
  (buffer  byte-reader-buffer set-byte-reader-buffer!))

(define (byte-reader file-or-port)
  (let ((port (if (port? file-or-port) file-or-port
                  (open-input-file file-or-port #:binary #t))))
    (%make-byte-reader port 0 0 #f)))

(define (prepare-buffer br)
  (let ((buffer (byte-reader-buffer br))
        (length (byte-reader-length br)))
    (cond ((not buffer)
           (let ((bv (make-bytevector 4096)))
             (set-byte-reader-buffer! br bv)))
          ((= length (bytevector-length buffer))
           (let ((bv (make-bytevector (* 2 length))))
             (bytevector-copy! buffer 0 bv 0 length)
             (set-byte-reader-buffer! br bv))))))

(define (read-some-bytes br)
  (prepare-buffer br)
  (let* ((port  (byte-reader-port br))
         (bv    (byte-reader-buffer br))
         (start (byte-reader-length br))
         (count (- (bytevector-length bv) start)))
    (match (get-bytevector-some! port bv start count)
      ((? eof-object?)
       #f)
      (result
       (set-byte-reader-length! br (+ start result))
       #t))))

(define (ensure-bytes br n)
  (let loop ()
    (cond ((<= n (byte-reader-length br)) #t)
          ((not (read-some-bytes br))     #f)
          (else (loop)))))

(define (get-bytes br offset count)
  (and (ensure-bytes br (+ offset count))
       (let* ((bv (byte-reader-buffer br))
              (p (bytevector->pointer bv)))
         (pointer->bytevector p count offset))))

(define (get-ascii br offset count)
  (let ((bv (get-bytes br offset count)))
    (and bv (bytevector->string bv "iso8859-1"))))

(define (get-int32 br offset)
  (and (ensure-bytes br (+ offset 4))
       (let ((bv (byte-reader-buffer br)))
         (bytevector-s32-ref bv offset (endianness big)))))

(define (get-byte br offset)
  (and (ensure-bytes br (+ offset 1))
       (let ((bv (byte-reader-buffer br)))
         (bytevector-u8-ref bv offset))))

(define (read-bytes br count)
  (let* ((start (byte-reader-cursor br))
         (value (get-bytes br start count)))
    (when value
      (set-byte-reader-cursor! br (+ start count)))
    value))

(define (read-remaining-bytes br)
  (let loop ()
    (when (read-some-bytes br)
      (loop)))
  (let* ((buffer (byte-reader-buffer br))
         (start  (byte-reader-cursor br))
         (count  (- (bytevector-length buffer) start)))
    (and (not (zero? count))
         (let* ((pointer (bytevector->pointer buffer))
                (result  (pointer->bytevector pointer count start)))
           (set-byte-reader-cursor! br (+ start count))
           result))))

(define (read-ascii br count)
  (let* ((start (byte-reader-cursor br))
         (value (get-ascii br start count)))
    (when value
      (set-byte-reader-cursor! br (+ start count)))
    value))

(define (read-int32 br)
  (let* ((start (byte-reader-cursor br))
         (value (get-int32 br start)))
    (when value
      (set-byte-reader-cursor! br (+ start 4)))
    value))

(define (read-byte br)
  (let* ((start (byte-reader-cursor br))
         (value (get-byte br start)))
    (when value
      (set-byte-reader-cursor! br (+ start 1)))
    value))

(define (assert-bytes br bytes)
  (let ((start (byte-reader-cursor br))
        (value (read-bytes br (bytevector-length bytes))))
    (unless (and value (bytevector=? value bytes))
      (error "Expected bytes:"
             `(expected ,bytes)
             `(received ,value)
             `(position ,start)))
    value))

(define (assert-ascii br str)
  (let ((start (byte-reader-cursor br))
        (value (read-ascii br (string-length str))))
    (unless (and value (string=? value str))
      (error "Expected ascii:"
             `(expected ,str)
             `(received ,value)
             `(position ,start)))
    value))

(define (assert-int32 br . expect)
  (let ((start (byte-reader-cursor br))
        (value (read-int32 br)))
    (unless (and value (member value expect =))
      (error "Expected int32:"
             `(expected ,expect)
             `(received ,value)
             `(position ,start)))
    value))

(define (assert-byte br . expect)
  (let ((start (byte-reader-cursor br))
        (value (read-byte br)))
    (unless (and value (member value expect =))
      (error "Expected byte:"
             `(expected ,expect)
             `(received ,value)
             `(position ,start)))
    value))
